home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / DRIVES.SWG / 0001_CDROM.PAS.pas next >
Pascal/Delphi Source File  |  1993-05-28  |  16KB  |  566 lines
  1. {
  2. > Are there anybody out there who has some routins to play CD Audio in a CD
  3. > ROM drive. Just the usual commands like play, stop, resume, eject and so
  4. > on. I would appreciate any help!
  5. }
  6.  
  7. Unit CDROM;
  8.  
  9. {  Unit talking to a CD-Rom-Drive
  10.    Low-level CD access,
  11.    only the first drive is supported...!
  12.    Copyright 1992  Norbert Igl  }
  13.  
  14. Interface
  15.  
  16. Type
  17.    CD_Record = Record
  18.                     Status : Word;    { Status des Drives/letzte Funktion }
  19.                     DrvChar: Char;    { LW-Buchstabe }
  20.                     DrvNo  : Byte;    { als Byte ablegegt (0...) }
  21.                     HSG_RB : Byte;    { Adressierungs-Modus }
  22.  
  23.                     Sector : LongInt; { Adresse des Lesekopfes }
  24.                     VolInfo: Array[1..8] of Byte; { Lautst.-Einstellungen }
  25.                     DevPar : LongInt; { Device-parameter, BIT-Feld! }
  26.                     RawMode: Boolean; { Raw/Cooked-Mode ? }
  27.                     SecSize: Word;    { Bytes/Sector }
  28.                     VolSize: LongInt; { sek/Volume => Groesse der CD}
  29.  
  30.                     MedChg : Byte;    { Disk gewechselt? }
  31.  
  32.                     LoAuTr : Byte;    { kleinste Audio-Track # }
  33.                     HiAuTr : Byte;    { groesste Audio-Track # }
  34.                     endAdr : LongInt; { Adresse der Auslaufrille (8-) }
  35.  
  36.                     TrkNo  : Byte;    { Track #. Eingabe-Wert ! }
  37.                     TrkAdr : LongInt; { Adresse dieses Tracks }
  38.                     TrkInf : Byte;    { Info dazu: BIT-Feld! }
  39.  
  40.                     CntAdr : Byte;   { CONTROL und ADR, von LW }
  41.                     CTrk   : Byte;   { track # }
  42.                     Cindx  : Byte;   { point/index }
  43.                     CMin   : Byte;   { minute\  }
  44.                     CSek   : Byte;   { second > Laufzeit im Track }
  45.                     CFrm   : Byte;   { frame /  }
  46.                     Czero  : Byte;   { immer =0 }
  47.                     CAmin  : Byte;   { minute \ }
  48.                     CAsec  : Byte;   { sekunde > Laufzeit auf Disk }
  49.                     CAFrm  : Byte;   { frame  / }
  50.  
  51.                     Qfrm   : LongInt;{ start-frame address }
  52.                     Qtrfs  : LongInt;{ Bufferaddresse }
  53.                     Qcnt   : LongInt;{ Anzahl der Sectoren }
  54.                       { pro Sector werden 96 Byte nach buffer kopiert }
  55.  
  56.                     Uctrl  : Byte;  { CONTROL und ADR Byte }
  57.                     Upn    : Array[1..7] of Byte; { EAN-CODE }
  58.                     Uzero  : Byte;  { immer = 0 }
  59.                     Ufrm   : Byte;  { Frame-# }
  60.                   end;
  61.       OneTrack             = Record
  62.                                Title   : String[20];
  63.                                Runmin,
  64.                                RunSec :  Byte;
  65.                                Start  :  LongInt;  { HSG Format ! }
  66.                              end;
  67.       VolumeTableOfContens = Record
  68.                                Diskname: String[20];
  69.                                UAN_Code: String[13];
  70.                                TrackCnt: Byte;
  71.                                Titles  : Array[1..99] of OneTrack;
  72.                              end;
  73.        TrkInfo  = Record
  74.                      Nummer  : Byte;
  75.                      Start   : LongInt;
  76.                      Cntrl2  : Byte;
  77.                   end;
  78. {===== global verfuegbare Variablen =============}
  79.  
  80. Var    CD           : CD_Record;
  81.        CD_AVAIL     : Boolean;
  82.        VtoC         : VolumeTableOfContens;
  83.        CD_REDPos    : String;
  84.        CD_HSGPos    : String;
  85.  
  86. {===== allgemeine Funktionen ===================}
  87.  
  88. Function CD_Reset   : Boolean;
  89. Function CD_HeadAdr : Boolean;
  90. Function CD_Position: Boolean;
  91. Function CD_MediaChanged: Boolean;
  92.  
  93.  
  94. {===== Tray/Caddy-Funktionen ===================}
  95.  
  96. Function CD_Open:  Boolean;
  97. Function CD_Close: Boolean;
  98. Function CD_Eject: Boolean;
  99.  
  100. {==== Audio-Funktionen =========================}
  101.  
  102. Function CD_Play(no:Byte; len:Integer):  Boolean;
  103. Function CD_Stop:  Boolean;
  104. Function CD_Resume:Boolean;
  105. Function CD_SetVol:Boolean;
  106. Function CD_GetVol:Boolean;
  107.  
  108. Procedure CD_Info;
  109. Procedure CD_TrackInfo( Nr:Byte; Var T:TrkInfo );
  110.  
  111. {==== Umwandlungen =============================}
  112.  
  113. Function Red2Time( Var Inf:TrkInfo ):Word;
  114.  
  115. Implementation Uses Dos;
  116. Type   IOCtlBlk = Array[0..200] of Byte;
  117.  
  118. Const  IOCtlRead  = $4402;
  119.        IOCtlWrite = $4403;
  120.        DevDrvReq  = $1510;
  121.        All:LongInt= $0f00;
  122.  
  123. Var  R        : Registers;
  124.      H        : Text;
  125.      Handle   : Word;
  126.      Old_Exit : Pointer;
  127.      CtlBlk   : IOCtlBlk;
  128.  
  129.      Tracks   : Array[1..100] of TrkInfo;
  130.  
  131. Procedure CD_Exit;               { wird bei Programmende ausgefuehrt }
  132. begin
  133.   if Old_Exit <> NIL
  134.     then ExitProc := Old_Exit;      { Umleitung wieder zuruecknehmen }
  135. {$I-}
  136.   Close(H);
  137.   If IoResult = 0 then;              { 'H' schliessen, falls offen, }
  138. {$I+}                                      { evtl. Fehler verwerfen }
  139. end;
  140.  
  141.  
  142. Function CD_Init:  Boolean;    { Initialisierung beim Programmstart }
  143. begin
  144.  FillChar( CD, SizeOf( CD ), 0);
  145.  With R do
  146.  begin
  147.    AX := $1500;
  148.    BX := $0000;
  149.    CX := $0000;
  150.    Intr( $2F, R );
  151.    CD_Init := (BX > 0);                  { Anzahl der CD-Laufwerke }
  152.    If BX > 0
  153.     then begin
  154.       CD.DrvChar                           { CD-Laufwerksbuchstabe }
  155.          := Char( CL + Byte('A') );
  156.       CD.DrvNo := CL;
  157.       If CD_HeadAdr then
  158.         If CD_GetVol then;
  159.     end
  160.     else CD.DrvChar := '?';                      { im Fehlerfall...}
  161.  end
  162. end;
  163.  
  164. Procedure CD_TrackInfo( Nr:Byte; Var T:TrkInfo );
  165. begin
  166.   T := Tracks[nr]
  167. end;
  168.  
  169. Function OpenCDHandle:Word;
  170. Const Name : String[8] = 'MSCD001';        { evt. anpassen!!! ? }
  171. begin
  172.   Assign(H, Name);                         { Filehandle holen }
  173. (*$I-*)
  174.   Reset(H);
  175. (*$I+*)
  176.   if IoResult = 0 then
  177.   begin
  178.     Handle := TextRec(H).Handle;                { Filehandle holen }
  179.     Old_Exit := ExitProc;           { Bei ende/Abbruch muss 'H'... }
  180.     ExitProc := @CD_Exit;      { ...automatisch geschlossen werden }
  181.   end
  182.   else Handle := 0;
  183.   OpenCDHandle := Handle;
  184. end;
  185.  
  186. Procedure CloseCDHandle;
  187. begin
  188.   if TextRec(H).Mode <> FmClosed
  189.      then ExitProc := Old_Exit;     { Umleitung wieder zuruecknehmen }
  190.   Old_Exit := NIL;
  191. {$I-}
  192.   Close(H);
  193.   If IoResult = 0 then;             { 'H' schliessen, falls offen, }
  194. {$I+}                                     { evtl. Fehler verwerfen }
  195. end;
  196.  
  197.  
  198. Function Red2HSG( Var Inf:TrkInfo ):LongInt;
  199. Var l: LongInt;
  200. begin
  201.       l :=     LongInt(( Inf.Start shr 16 ) and $FF )  * 4500;
  202.       l := l + LongInt(( Inf.Start shr  8 ) and $FF )  * 75;
  203.       l := l + LongInt(( Inf.Start        ) and $FF ) ;
  204.  
  205.   Red2HSG := l -2;
  206. end;
  207.  
  208. Function Red2Time( Var Inf:TrkInfo ):Word;
  209. begin
  210.   Red2Time:= (( Inf.Start shr 24 ) and $FF ) shl 8
  211.            + (( Inf.Start shr 16 ) and $FF )
  212. end;
  213.  
  214. Function HSG2Red(L:LongInt):LongInt;
  215. begin
  216. end;
  217.  
  218. Function CD_IOCtl( Func, Len : Word) :  Boolean;
  219. begin
  220.   With R do
  221.   begin
  222.     AX := Func;
  223.     BX := OpenCDHandle;
  224.     CX := 129;
  225.     DS := DSeg;
  226.     ES := DS;
  227.     DX := Ofs(CtlBlk);
  228.     MsDos( R );
  229.     CD.Status := AX;
  230.     CD_IOCtl  := (Flags and FCARRY) = 0;
  231.     CloseCDHandle;
  232.   end
  233. end;
  234.  
  235.  
  236. Function CD_Reset: Boolean;
  237. begin
  238.   CtlBlk[0] := 2;   { Reset }
  239.   CD_Reset  := CD_IoCtl( IoCtlWrite, 1)
  240. end;
  241.  
  242. Function DieTuer( AufZu:Byte ): Boolean;
  243. begin
  244.   CtlBlk[0] := 1;                                      { die Tuer.. }
  245.   CtlBlk[1] := AufZu;                                { ..freigeben }
  246.   DieTuer := CD_IoCTL(IoCtlWrite, 2);
  247. end;
  248.  
  249. Function CD_Open: Boolean;
  250. Const Auf = 0;
  251. begin
  252.  CD_Open := DieTuer( Auf );
  253. end;
  254.  
  255. Function CD_Close: Boolean;
  256. Const Zu = 1;
  257. begin
  258.  CD_Close := DieTuer( Zu );
  259. end;
  260.  
  261.  
  262. Function CD_Eject: Boolean;
  263. begin
  264.   CtlBlk[0] := 0;                                   { CD auswerfen }
  265.   CD_Eject  := CD_IOCtl(IoCtlWrite, 1);
  266. end;
  267.  
  268.  
  269. Function CD_Play(no:Byte; len:Integer):  Boolean;
  270. begin                                               { CD PlayAudio }
  271.  
  272.   FillChar(CtlBlk, SizeOf(CtlBlk), 0);
  273.   CtlBlk[0] := 22;                             { laenge des req-hdr }
  274.   CtlBlk[1] := 0;                                       { sub-Unit }
  275.   CtlBlk[2] := $84;                                     { Kommando }
  276.   CtlBlk[3] := 0;                                    { Status-WORT }
  277.   CtlBlk[4] := 0;
  278.   CtlBlk[5] := 0;
  279.   CtlBlk[13]:= CD.HSG_RB;                             { HSG-Modus }
  280.  
  281.   CD.Sector := VtoC.Titles[no].Start;          { ist im HSG-Format }
  282.  
  283.   Move( CD.Sector, CtlBlk[14], 4 );                 { Start-Sector }
  284.   if len = -1
  285.     then All := $FFFF
  286.     else All := len;
  287.   Move( All      , CtlBlk[18], 4 );               { Anzahl Sectoren}
  288.   Asm
  289.      mov  ax, $1510
  290.      push ds
  291.      pop  es
  292.      xor  cx, cx
  293.      mov  cl, CD.DrvNo
  294.      mov  bx, offset CtlBlk
  295.      Int $2f
  296.   end;
  297.  
  298.   CD.Status := CtlBlk[3] or CtlBlk[4] shl 8;
  299.   CD_Play   := CD.Status and $8000 = 0;
  300.  
  301. end;
  302.  
  303. Function CD_VtoC:Boolean;
  304. Var i: Byte;
  305.     l: LongInt;
  306. begin
  307.   FillChar( Tracks, SizeOf( Tracks ), 0);
  308.   CtlBlk[0] := 10;                               { Read LeadOut-Tr }
  309.   CD_IoCtl( IoCtlRead, 6);
  310.   Move( CtlBlk[1], CD.LoAuTr, 6);
  311.   i := CD.HiAuTr+1;
  312.   Move( CtlBlk[3], Tracks[i], 4);      { die Auslaufrille 8-) }
  313.   Tracks[i].Start := Red2Hsg(Tracks[i]);
  314.  
  315.   For i := CD.LoAuTr to CD.HiAuTr do
  316.   begin
  317.     FillChar(CtlBlk, SizeOf(CtlBlk), 0);           { RED-Book-Format }
  318.     CtlBlk[0] := 11;                               { Read VtoC-Entry }
  319.     CtlBlk[1] := i;                                       { track-no }
  320.     CD_IoCtl( IoCtlRead, 6);
  321.     Move( CtlBlk[1], Tracks[i], 6);
  322. {   Tracks[i].Start := Red2Hsg(Tracks[i]); }
  323.   end;
  324.  
  325.  
  326.   With VtoC do
  327.   begin
  328.     DiskName := '';
  329.     UAN_Code := '';
  330.     TrackCnt := CD.HiAuTr;
  331.     For i := CD.LoAuTr to CD.HiAuTr do
  332.     With Titles[i] do
  333.     begin
  334.       L := LongInt((Tracks[i+1].Start shr 16) and $FF) * 60
  335.         +         (Tracks[i+1].Start shr  8) and $FF
  336.         - ( LongInt((Tracks[i].Start shr 16) and $FF) * 60
  337.                  +  (Tracks[i].Start shr  8) and $FF);
  338.       Title  := '???';
  339.       RunMin := L div 60;
  340.       RunSec := l - RunMin*60;
  341.       Start  := Red2Hsg(Tracks[i]);
  342.     end
  343.   end;
  344.  
  345.  
  346.  
  347. end;
  348.  
  349. Function CD_Stop:  Boolean;
  350. begin                                               { CD StopAudio }
  351.   FillChar(CtlBlk, SizeOf(CtlBlk), 0);
  352.   CtlBlk[0] := 5;                             { laenge des req-hdr }
  353.   CtlBlk[1] := 0;                                       { sub-Unit }
  354.   CtlBlk[2] := $85;                                     { Kommando }
  355.   CtlBlk[3] := 0;                                    { Status-WORT }
  356.   CtlBlk[4] := 0;
  357.   CtlBlk[5] := 0;
  358.   Asm
  359.      mov  ax, $1510
  360.      push ds
  361.      pop  es
  362.      xor  cx, cx
  363.      mov  cl, CD.DrvNo
  364.      mov  bx, offset CtlBlk
  365.      Int $2f
  366.   end;
  367.  
  368.   CD.Status := CtlBlk[3] or CtlBlk[4] shl 8;
  369.   CD_Stop   := CD.Status and $8000 = 0;
  370.  
  371. end;
  372.  
  373.  
  374. Function CD_Resume:Boolean;
  375. begin                                                 { ResumeAudio}
  376.   CtlBlk[0] := 3;                              { laenge des req-hdr }
  377.   CtlBlk[1] := 0;                                       { sub-Unit }
  378.   CtlBlk[2] := $88;                                     { Kommando }
  379.   CtlBlk[3] := 0;                                    { Status-WORT }
  380.   CtlBlk[4] := 0;
  381.   Asm
  382.      mov ax, Seg @DATA
  383.      mov es, ax
  384.      mov ax, DevDrvReq
  385.      lea bx, CtlBlk
  386.      Int 2fh
  387.   end;
  388.   CD.Status := CtlBlk[3] or CtlBlk[4] shl 8;
  389.   CD_Resume := CD.Status and $8000 = 0;
  390.  
  391. end;
  392.  
  393. Function CD_GetVol:Boolean;
  394. begin
  395.   CtlBlk[0] := 4;                           { die Lautstaerke lesen }
  396.   CD_GetVol := CD_IOCtl(IoCtlRead, 8);
  397.   if ((R.Flags and FCARRY) = 0)
  398.    then Move(CtlBlk[1], CD.VolInfo, 8)
  399.    else FillChar( CD.VolInfo, 8, 0)
  400. end;
  401.  
  402. Function CD_SetVol:Boolean;
  403. begin
  404.   CtlBlk[0] := 3;                          { die Lautstaerke setzen }
  405.   CD_SetVol := CD_IOCtl( IoCtlWrite, 8);
  406. end;
  407.  
  408. Function CD_HeadAdr: Boolean;
  409. Var  L:LongInt;  S:String;
  410. begin
  411.   FillChar(CtlBlk, SizeOf(CtlBlk), 0);
  412.   CtlBlk[0] := 1;
  413.   CtlBlk[1] := 1;                     { die KopfPosition im RED-Format }
  414.   CD_HeadAdr:= CD_IOCtl(IoCtlRead, 128);
  415.   if ((R.Flags and FCARRY) = 0)
  416.     then begin
  417.            Move(CtlBlk[2], L, 4);
  418.            if CtlBlk[1] = 1 then
  419.            begin
  420.              STR( CtlBlk[4]:2, S);  CD_REDPos := S;
  421.              STR( CtlBlk[3]:2, S);  CD_REDPos := CD_REDPos+ ':'+ S;
  422.              CD.Sector := LongInt(CtlBlk[4]) *4500 +
  423.                           LongInt(CtlBlk[3]) *75   +
  424.                           LongInt(CtlBlk[2])
  425.                           - 150;
  426.            end else
  427.            begin
  428.              CD.Sector := L;
  429.              STR(L:0,CD_HSGPos);
  430.            end
  431.  
  432.          end
  433.     else FillChar( CD.Sector, 4, 0);
  434. end;
  435.  
  436.  
  437. Function CD_Position:Boolean;
  438. Var l : LongInt;
  439. begin
  440.   CtlBlk[0] := 12;                                  { Audio-Infos  }
  441.   CD_Position :=CD_IOCtl(IoCtlRead,10);
  442.   Move(CtlBlk[1], CD.CntAdr, 10);
  443. end;
  444.  
  445.  
  446. Procedure CD_GetUAN;
  447. begin
  448.   CtlBlk[0] := 14;                                  { EAN-Nummer   }
  449.   If CD_IOCtl(IoCtlRead,10)
  450.     then Move(CtlBlk[1], CD.Uctrl, 10);
  451. end;
  452.  
  453.  
  454. Function CD_MediaChanged:Boolean;
  455. begin
  456.   CtlBlk[0] := 9;                                   { Media-Change }
  457.   If CD_IOCtl(IoCtlRead, 1)
  458.     then Move(CtlBlk[1], CD.MedChg, 1 );
  459.   CD_MediaChanged:= CD.MedChg <> 1
  460. end;
  461.  
  462. Procedure CD_Info;
  463. begin
  464.  
  465.  { CD_Reset; }
  466.  
  467.   If CD_HeadAdr then;
  468.  
  469.   CtlBlk[0] := 6;                               { Device-parameter }
  470.   If CD_IOCtl(IoCtlRead, 4)
  471.     then Move(CtlBlk[1], CD.DevPar, 4 );
  472.  
  473.   CtlBlk[0] := 7;                                   { Sector-Groesse }
  474.   If CD_IOCtl(IoCtlRead, 3)                              { & Modus }
  475.     then Move(CtlBlk[1], CD.RawMode, 3 );
  476.  
  477.   CtlBlk[0] := 8;                                   { Volume-Groesse }
  478.   If CD_IOCtl(IoCtlRead, 4)
  479.     then Move(CtlBlk[1], CD.VolSize, 4 );
  480.  
  481.   CtlBlk[0] := 12;                                  { Audio-Infos  }
  482.   If CD_IOCtl(IoCtlRead,10)
  483.     then Move(CtlBlk[1], CD.CntAdr, 10);
  484.  
  485.   CtlBlk[0] := 11;                                  { Track-Infos  }
  486.   CtlBlk[1] := CtlBlk[2];                           { aktueller... }
  487.   If CD_IOCtl(IoCtlRead, 6)
  488.     then Move(CtlBlk[1], CD.TrkNo, 6 );
  489.  
  490.   CD_VtoC;
  491.  
  492. end;
  493.  
  494. {========= minimale Initialisierung =============}
  495. begin
  496.   CD_Avail := CD_Init;
  497.   if CD_Avail then CD_INFO
  498. end. Norbert
  499.  
  500. {
  501. --- part 2, a Test -----
  502. }
  503. Program CDROM_TEST;
  504. Uses Crt, cdrom, SbTest;
  505. Type a5 = Array[0..4] of Byte;
  506. Var i:Byte;
  507.     L : LongInt;
  508.     ch : Char;
  509.     no,
  510.     len : Integer;
  511.  
  512. begin
  513.   ClrScr;
  514.   WriteLn('CDROM-Unit TestProgram',#10);
  515.   With CD do
  516.   if CD_Avail then
  517.   begin
  518.    WriteLn('■ CD als Laufwerk ',DrvChar,': gefunden!');
  519.    Write  ('■ Aktuelle CD: ');
  520.  
  521.    Write('(UPN-CODE:');
  522.    For i := 1 to 7 do Write(Char( (Upn[i] shr 4)  or $30),
  523.                             Char((Upn[i] and $f) or $30));
  524.    WriteLn(#8')');
  525.    WriteLn('■ Audio-Tracks : ',loautr,'..',hiautr);
  526.    WriteLn(' Laufzeiten : ');
  527.    For i := CD.LoAuTr to CD.HiAuTr do
  528.     With VtoC.Titles[i] do
  529.       WriteLn(i,Title:10, RunMin:6,':',RunSec);
  530.    no := 1;
  531.    len := -1;
  532.  
  533.    if CD_Stop then
  534.      if not CD_Play( no ,len)
  535.         then WriteLn('! Fehler-Status: ',STATUS and $F);
  536.  
  537.    ch := ' ';
  538.    While ch <> #27 do
  539.    begin
  540.    While ch = ' ' do
  541.      With CD do
  542.      begin
  543.        if CD_Position then
  544.          Write('Playing Track ',CTrk,'  :   ',CMin:2,':',CSek:2,'   '#13);
  545.        Delay(1500);
  546.        if KeyPressed
  547.           then ch := ReadKey;
  548.      end;
  549.      Case ch of
  550.        '+' : Inc(no);
  551.        '-' : Dec(no);
  552.      end;
  553.      if ch <> #27 then ch := ' ';
  554.      if no > cd.HiAUTr then Dec(no);
  555.      if no < cd.LoAuTr then Inc(no);
  556.      if CD_Stop
  557.        then CD_Play(no, len);
  558.    end;
  559.    cd_stop;
  560.    clreol;
  561.    WriteLn(' CD stopped...');
  562.   end
  563.   else WriteLn('Leider kein CD-ROM gefunden...');
  564. end.
  565.  
  566.